home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Purity / Purity #52 (1995-10-30)(PackMAN)(DE)[WB, FFS].zip / Purity #52 (1995-10-30)(PackMAN)(DE)[WB, FFS].adf / RemMem / RemMem.p < prev    next >
Text File  |  1995-10-29  |  2KB  |  89 lines
  1. PROGRAM RemMemory;
  2.  
  3. { ** Erzeugt künstliche Speicherknappheit
  4.   **
  5.   ** (C) 1995 by Björn Schotte, FREEWARE
  6.   **
  7.   ** EMail: bjoern@bomber.mayn.de
  8.   **
  9.   ** }
  10.   
  11. USES Exec;
  12.  
  13. {$opt q;incl "dos.lib"}
  14.  
  15. TYPE
  16.   targ = RECORD
  17.     bytes    : ^LONG;
  18.      typ     : STR;
  19.   END;
  20.   
  21. CONST
  22.   _id = "$VER: RemMem V1.00 (24.10.1995)";
  23.   
  24. VAR
  25.   template : STRING;
  26.   arg : ^targ;
  27.   rd : p_RDArgs;
  28.   i,mysize,size,memo : LONG;
  29.   typ : STRING;
  30.   p : PTR;
  31.  
  32. PROCEDURE Upper(VAR s:STRING);
  33. VAR i : INTEGER;
  34. BEGIN
  35.   FOR i := 1 TO Length(s) DO s[i] := Upcase(s[i]);
  36. END;
  37.       
  38. BEGIN
  39.   OpenLib(DOSBase, "dos.library", 37);
  40.   IF FromWB THEN EXIT;
  41.   template := "SIZE/N,TYPE";
  42.   arg := AllocVec(SizeOf(targ),MEMF_ANY OR MEMF_CLEAR);
  43.   IF arg = NIL THEN
  44.   BEGIN
  45.      Writeln("Not enough memory free!");
  46.      DOSExit(20);
  47.   END;
  48.   rd := ReadArgs(^template,arg,NIL);
  49.   IF rd <> NIL THEN
  50.   BEGIN
  51.      IF arg^.typ <> "" THEN typ := arg^.typ ELSE typ := "ANY";
  52.      Upper(typ);
  53.      if arg^.bytes <> NIL THEN size := arg^.bytes^ ELSE size := 0;
  54.      FreeArgs(rd);
  55.      IF size = 0 THEN
  56.      BEGIN
  57.         FreeVec(arg);
  58.         Writeln("Memory size must be greater than 0!");
  59.         DosExit(20);
  60.      END;
  61.      IF typ = "ANY" THEN
  62.        i := MEMF_ANY
  63.      ELSE IF typ = "PUBLIC" THEN
  64.        i := MEMF_PUBLIC
  65.      ELSE IF typ = "FAST" THEN
  66.        i := MEMF_FAST
  67.      ELSE IF typ = "CHIP" THEN
  68.        i := MEMF_CHIP
  69.      ELSE BEGIN
  70.         FreeVec(arg);
  71.         Writeln("Wrong memory type!");
  72.         DosExit(20);
  73.     END;
  74.      memo := AvailMem(i OR MEMF_LARGEST);
  75.      mysize := memo - size*1024;
  76.      p := AllocVec(mysize,i);
  77.      IF p = NIL THEN
  78.      BEGIN
  79.         Writeln("Couldn't allocate ",size:8," bytes of memory!");
  80.         DosExit(20);
  81.      END;
  82.      Writeln("Waiting for ^C...");
  83.      i := _Wait(SIGBREAKF_CTRL_C);
  84.      FreeVec(p);
  85.   END;
  86.   FreeVec(arg);
  87.   DOSExit(0);
  88. END.
  89.